# limpieza del ambiente
rm(list = ls())

# carga de librerías
require(pacman)

# Cargar librerías necesarias
p_load(tidyverse,     # Gestión de datos
       zeallot,       # Abilita el operador %<-%
       #haven,         # lectura de datos en diferentes formatos
       readr,         # Lectura de archivos de texto delimitados
       doBy,          # Colapsar la base
       readxl,        # Importar excel
       purrr,         # Programación funcional
       stringr,       # Manejo de cadenas de texto
       rgdal,         # Gestión de datos geoespaciales
       tmaptools,     # Herramientas para mapas temáticos
       grid,          # Manejo de graficos en cuadriculas
       sp,            # Manejo de datos espaciales
       sf,            # Para el análisis de Hotspots
       ggplot2,       # Librería de gráficas
       bestNormalize, # Normalización de datos
       spdep,         # Aplicación del test de Moran
       sfdep,         # Necesaria para análisis espacial
       igraph,        # Crear mapas desde lostas adjacentes
       writexl)       # Exportar a Excel

# Establecer directorio de trabajo
# Este código establece la ubicación donde está el script como directorio de trabajo
path_script <- rstudioapi::getActiveDocumentContext()$path
path_folder <- dirname(path_script)
setwd(dirname(path_folder))

options(scipen = 999)

# Dirección para exportar gráficos
# El código dirname eleva un nivel de la carpeta y posteriormente busca una 
# carpeta que se llame Gráficas
dir_graph <- file.path(dirname(path_folder), 
                       "Gráficas")

# Dirección para cargar la base de datos
# El código dirname eleva un nivel de la carpeta y posteriormente busca una 
# carpeta que se llame Salidas
dir_output <- file.path(dirname(path_folder), 
                        "Salidas")

#CARGA DE BASES DE DATOS ORIGINALES

T_1_3_AJUSTADO_V1 <- read_delim("Entradas/T.1.3 AJUSTADO V2.txt", 
                                delim = "|", escape_double = FALSE, 
                                col_types = cols(ID_MUNICIPIO = col_character(),
                                                 MARCA = col_number(), 
                                                 `ACCESOS AJUSTADOS` = col_number(),
                                                 PENETRACION = col_number()), 
                                trim_ws = TRUE) %>%
  rename(ACCESOS="ACCESOS AJUSTADOS") %>%
  mutate(television = if_else(ID_SERVICIO_PAQUETE == 3 | ID_SERVICIO_PAQUETE >=5, 1, 0),
         internet = if_else(ID_SERVICIO_PAQUETE == 1 | ID_SERVICIO_PAQUETE == 4 | ID_SERVICIO_PAQUETE == 5 | ID_SERVICIO_PAQUETE == 7, 1, 0),
         int_telef = if_else(ID_SERVICIO_PAQUETE == 4 | ID_SERVICIO_PAQUETE == 7, 1, 0),
         int_tv = if_else(ID_SERVICIO_PAQUETE == 5 | ID_SERVICIO_PAQUETE == 7, 1, 0)) %>%
  group_by(ANNO,TRIMESTRE,ID_MUNICIPIO,television) %>%
  mutate(ACCESOS_TV = sum(ACCESOS),
         ACCESOS_TV = if_else(television == 0, 0, ACCESOS_TV)) %>%
  ungroup()%>%
  group_by(ANNO,TRIMESTRE,ID_MUNICIPIO,internet) %>%
  mutate(ACCESOS_IF = sum(ACCESOS),
         ACCESOS_IF = if_else(internet==0,0,ACCESOS_IF)) %>%
  ungroup()%>%
  group_by(ANNO,TRIMESTRE,ID_MUNICIPIO,int_telef) %>%
  mutate(ACCESOS_I_TELEF = sum(ACCESOS),
         ACCESOS_I_TELEF = if_else(int_telef==0,0,ACCESOS_I_TELEF)) %>%
  ungroup()%>%
  group_by(ANNO,TRIMESTRE,ID_MUNICIPIO,int_tv) %>%
  mutate(ACCESOS_I_TV = sum(ACCESOS),
         ACCESOS_I_TV = if_else(int_tv==0,0,ACCESOS_I_TV)) %>%
  ungroup() %>%
  mutate(PENET_TV = (ACCESOS_TV/HOGARES),
         PENET_IF = (ACCESOS_IF/HOGARES),
         PENET_I_TELF = (ACCESOS_I_TELEF/HOGARES),
         PENET_I_TV = (ACCESOS_I_TV/HOGARES))


mpio<- "mpio"
municipios_mapa <- readOGR(dsn = "Entradas/MPIO", layer = mpio)
municipios_mapa@data$ID_MUNICIPIO <- as.character(municipios_mapa@data$MPIOS)
municipios_mapa@data$ID_MUNICIPIO <- str_remove(municipios_mapa@data$ID_MUNICIPIO, "^0")

##### SELECCIONAR EL CÓDIGO DEL SERVICIO QUE SE ESTÁ ANALIZANDO
### SERVICIOS INDIVIDUALES
# 1: Internet fijo
# 3: Televisión
### SERVICIOS EMPAQUETADOS X-PLAY
# 4: Dúo Play 1
# 5: Dúo Play 2
# 7: Triple Play 1
id_serv <- 4

nombre_paquete <- if_else(id_serv == 4, "Duoplay1",
                          if_else(id_serv == 5, "Duoplay2", "3play"))

Mercado <- T_1_3_AJUSTADO_V1 %>%
  filter(ID_SERVICIO_PAQUETE == id_serv, ACCESOS > 0) %>%
  select(-c("HOGARES", "ACCESOS AJUSTADOS_Max")) %>%
  mutate(PEN_SERVICIO = case_when(
    id_serv == 1 ~ PENET_IF,       # Penetración de internet fijo
    id_serv == 3 ~ PENET_TV,       # Penetracón de televisión
    id_serv == 4 ~ PENET_I_TELF,   # Penetración de Dúo Play 1
    id_serv == 5 ~ PENET_I_TV,     # Penetración de Dúo Play 2
    TRUE ~ PENETRACION             # Penetración de Triple Play
  )) %>%
  select(c("ANNO", "TRIMESTRE", "DP", "DPNOM", "ID_MUNICIPIO", "MUNICIPIO-", "CLUSTER2",
           "ID_SERVICIO_PAQUETE", "ID_EMPRESA", "EMPRESA", "MARCA", "ACCESOS", 
           "PENETRACION", "PEN_SERVICIO"))


################################
## ANÁLISIS DE COMPETENCIA

Mercado <- Mercado %>%
  group_by(ANNO,TRIMESTRE,ID_MUNICIPIO) %>%
  mutate(ACC_MUN=sum(ACCESOS),
         EMPR_U=n_distinct(ID_EMPRESA),
         PEN_MUN=sum(PENETRACION)*100,
         #PEN_SERVICIO=ifelse(id_serv==7, sum(PENETRACION)*100, max(PEN_SERVICIO)*100),  # Ajustado para que funcione para ambos casos
         PEN_SERVICIO=mean(PEN_SERVICIO)*100,
         PARTICIPACION=(ACCESOS/ACC_MUN)*100,
         PART2=PARTICIPACION^2,
         HHI=sum(PART2),
         DOM=((PART2/HHI)^2),
         DOM_MUN=sum(DOM))%>%
  arrange(ANNO,TRIMESTRE,ID_MUNICIPIO,desc(PARTICIPACION)) %>%
  mutate(n=row_number(),
         S1=max(PARTICIPACION)/100,
         S2=(PARTICIPACION[n==2][1])/100) %>%
  replace(is.na(.), 0) %>%
  mutate(SB=1/2*(1-(S1^2-S2^2)),
         DIFERENCIA=S1-SB)

write_csv2(Mercado, "Salidas/Tp.csv")
write_csv2(Mercado, "Salidas/Dp2.csv")

municipios0 <- Mercado %>%
  group_by(ANNO,TRIMESTRE,ID_MUNICIPIO) %>%
  summarise(CLUSTER2=first(CLUSTER2),
            HHI=mean(HHI),
            DOM_MUN=mean(DOM_MUN),
            S1=mean(S1),
            DIF_SB=mean(DIFERENCIA),
            PEN_M=mean(PEN_MUN),
            PEN_S=mean(PEN_SERVICIO)) %>%
  ungroup() %>%
  unite("AATT", ANNO, TRIMESTRE, sep = "_") %>%
  pivot_wider(
    names_from = AATT,
    values_from = c(HHI, DOM_MUN, S1, DIF_SB, PEN_M, PEN_S)) %>%
  mutate(MONOPOLIO=ifelse(rowSums(across(c(HHI_2024_1, HHI_2024_2, HHI_2024_3), ~ . == 10000), na.rm=T) >= 2, 1, 0)) %>%
  ungroup()

# Cantidad de monopolios
sum(municipios0$MONOPOLIO == 1, na.rm = TRUE)

# Base para continuar con el análisis sin monopolios
municipios <- municipios0 %>%
  filter(MONOPOLIO==0)

######
#  Cálculos para corrección de atípicos con rango intercuartílico


# Función para reemplazar valores atípicos dentro de cada ID_MUNICIPIO

reemplazar_atipicos <- function(df, variable) {
  df <- df %>%
    group_by(ID_MUNICIPIO) %>%  # Agrupar por individuo
    mutate(
      Q1 = quantile(c_across(starts_with(variable)), 0.25, na.rm = TRUE),
      Q3 = quantile(c_across(starts_with(variable)), 0.75, na.rm = TRUE),
      IQR_x = Q3 - Q1,
      median_x = median(c_across(starts_with(variable)), na.rm = TRUE),
      across(starts_with(variable), 
             ~ ifelse(. < (Q1 - 1.5 * IQR_x) | . > (Q3 + 1.5 * IQR_x), median_x, .))
    ) %>%
    ungroup() %>%
    select(-Q1, -Q3, -IQR_x, -median_x)  # Elimina columnas auxiliares
  
  return(df)
}

# Función para calcular la pendiente solo si hay suficientes datos
calculo_pendiente <- function(valores, trimestre) {
  valores_no_na <- na.omit(valores)
  
  if (length(valores_no_na) > 1) {
    modelo <- lm(valores ~ trimestre)
    return(coef(modelo)[2])  # Devuelve la pendiente
  } else {
    return(NA_real_)  # Si no hay datos suficientes, devuelve NA
  }
}

trim_num <- 1:9

# Función principal que primero filtra valores atípicos y luego calcula la pendiente
indicadores <- function(base, variable) {
  # Primero, limpiamos los valores atípicos
  df_limpio <- reemplazar_atipicos(base, variable)
  
  # Luego, calculamos pendiente y promedio
  resultados <- df_limpio %>%
    rowwise() %>%
    mutate(
      pendiente = if (sum(!is.na(c_across(starts_with(variable)))) > 1) {
        calculo_pendiente(c_across(starts_with(variable)), trim_num)
      } else {
        NA_real_
      },
      promedio = mean(c_across(starts_with(variable)), na.rm = TRUE)  # Promedio ignorando NA
    ) %>%
    ungroup() %>%
    select(ID_MUNICIPIO, starts_with(variable), pendiente, promedio)  # Selecciona variables relevantes
  
  return(resultados)
}


# A continuación se genera una base para cada uno de los índices. Tienen todos los valores originales
# y al final se genera la variable promedio y pendiente, que se calcularon sacando los átípicos

res_HHI <- indicadores(municipios,"HHI")
res_DIF_SB <- indicadores(municipios,"DIF_SB")
res_PEN_M <- indicadores (municipios,"PEN_M")
res_PEN_S <- indicadores (municipios,"PEN_S")


################
# Generación de tabla de estadísiticas por cada variable (para referencia, no es necesario correrlo)

# Crear la lista de bases de datos
bases <- list(res_HHI = res_HHI, res_DIF_SB = res_DIF_SB, res_PEN_M = res_PEN_M, res_PEN_S = res_PEN_S)

# Función para calcular las estadísticas de pendiente y promedio
calc_estadisticas <- function(data) {
  data <- data %>% ungroup()  # Elimina cualquier agrupamiento o 'rowwise'
  data %>%
    summarise(across(
      c(promedio, pendiente),  # Seleccionar solo las columnas específicas
      list(
        Min = ~min(.x, na.rm = TRUE),
        Max = ~max(.x, na.rm = TRUE),
        Mean = ~mean(.x, na.rm = TRUE),
        Median = ~median(.x, na.rm = TRUE),
        SD = ~sd(.x, na.rm = TRUE)
      ),
      .names = "{.col}_{.fn}"  # Crear nombres como pendiente_Min, pendiente_Mean, etc.
    ))
}

# Aplicar la función a todas las bases y combinar los resultados en una tabla
tabla_estadisticas <- bases %>%
  map(~ calc_estadisticas(.x)) %>%
  bind_rows(.id = "Base")  # Agregar el nombre de la base

# Exportar
#write.csv2(tabla_estadisticas, file="Salidas/estadisticas_3play.csv", row.names = F)



###############
# UMBRALES

# Se generaron así para prever si hacíamos en algún punto un cambio de umbrales
u_HHI <- 3000
u_DIFSB <- 0
u_PENET <- mean(res_PEN_M$promedio, na.rm = TRUE) + sd(res_PEN_M$promedio, na.rm = TRUE) #este no se tiene en cuenta al final
u_pend <- 0

xHHI <- max((res_HHI$pendiente), na.rm = TRUE)
xDIFSB <- max((res_DIF_SB$pendiente), na.rm = TRUE)
xPENET <- ifelse(id_serv==7, min((res_PEN_M$pendiente), na.rm = TRUE), min((res_PEN_S$pendiente), na.rm = TRUE)) #Ajustado para ambos casos

xPENET <- abs(xPENET)

# Los valores del índice inferiores al umbral se transforman a 0. El resto de valores
# se normalizan entre 0.01 y 1. Para las tendencias, todas tienen la misma 
# normalización que los niveles, con umbral = 0.

# A continuación, se hace cada una de las normalizaciones y se genera una variable que 
# termina en indice, para el promedio de cada variable normalizada, e ipend para las 
# tendencias normalizadas.

res_HHI <- res_HHI %>%
  mutate_at(vars(pendiente,promedio), ~replace(., is.na(.),0)) %>%
  mutate(HHI_indice = if_else(promedio < u_HHI, 0 , 0.01+(0.99*((promedio-u_HHI)/(10000-u_HHI)))),
         HHI_ipend = if_else(pendiente < u_pend | promedio < u_HHI, 0, 0.01+(0.99*((pendiente-u_pend)/(xHHI-u_pend))))) %>%
  rename(HHI_promedio = promedio,
         HHI_pendiente = pendiente)

res_DIF_SB <- res_DIF_SB %>%
  mutate_at(vars(pendiente,promedio), ~replace(., is.na(.),0)) %>%
  mutate(DIFSB_indice = if_else(promedio < 0, 0, promedio),
         DIFSB_ipend = if_else(pendiente < u_pend | promedio < u_DIFSB, 0, 0.01+(0.99*((pendiente-u_pend)/(xDIFSB-u_pend))))) %>%
  rename(DIFSB_promedio = promedio,
         DIFSB_pendiente = pendiente)

res_PEN_M <- res_PEN_M %>%
  mutate_at(vars(pendiente,promedio), ~replace(., is.na(.),0)) %>%
  mutate(
    PEN_indice = ifelse(promedio > u_PENET, 0, 0.99 * (1 - (promedio / u_PENET)) + 0.01),
    PEN_ipend = if_else(pendiente > u_pend, 0,
                        0.01 + (abs(pendiente) /xPENET) * 0.99))  %>%
  rename(PEN_promedio = promedio,
         PEN_pendiente = pendiente)  

res_PEN_S <- res_PEN_S %>%
  mutate_at(vars(pendiente,promedio), ~replace(., is.na(.),0)) %>%
  mutate(
    PEN_indice = ifelse(promedio > u_PENET, 0, 0.99 * (1 - (promedio / u_PENET)) + 0.01),
    PEN_ipend = if_else(pendiente > u_pend, 0,
                        0.01 + (abs(pendiente) /xPENET) * 0.99))  %>%
  rename(PEN_promedio = promedio,
         PEN_pendiente = pendiente)

#################
### Cálculo del índice de competencia global

competencia <- municipios0 %>%
  select(ID_MUNICIPIO, MONOPOLIO) %>%
  left_join(select(res_HHI, ID_MUNICIPIO, HHI_promedio, HHI_pendiente, HHI_indice, HHI_ipend) %>%
              mutate(across(c(HHI_promedio, HHI_pendiente, HHI_indice, HHI_ipend), as.numeric)), by = "ID_MUNICIPIO") %>%
  left_join(select(res_DIF_SB, ID_MUNICIPIO, DIFSB_promedio, DIFSB_pendiente, DIFSB_indice, DIFSB_ipend) %>%
              mutate(across(c(DIFSB_indice, DIFSB_ipend, DIFSB_promedio, DIFSB_pendiente), as.numeric)), by = "ID_MUNICIPIO") %>%
  
  # Se unen los conjuntos de datos en función del servicio (id_serv)
  left_join(
    case_when(
      id_serv %in% c(1, 3, 4, 5) ~ select(res_PEN_S, ID_MUNICIPIO, PEN_promedio, PEN_pendiente, PEN_indice, PEN_ipend) %>%
        mutate(across(c(PEN_indice, PEN_ipend, PEN_promedio, PEN_pendiente), as.numeric)),
      id_serv == 7 ~ select(res_PEN_M, ID_MUNICIPIO, PEN_indice, PEN_ipend, PEN_promedio, PEN_pendiente) %>%
        mutate(across(c(PEN_indice, PEN_ipend, PEN_promedio, PEN_pendiente), as.numeric))
    ),
    by = "ID_MUNICIPIO"
  ) %>%
  
  mutate(
    algoritmo = rowSums(
      select(., HHI_indice, HHI_ipend, DIFSB_indice, DIFSB_ipend, PEN_ipend) > 0, na.rm = TRUE
    ),
    iglobal0 = rowMeans(
      select(., HHI_indice, HHI_ipend, DIFSB_indice, DIFSB_ipend, PEN_ipend), na.rm = TRUE
    ),
    iglobal = if_else(MONOPOLIO == 1, 1, iglobal0)
  ) %>%
  ungroup()


# Municipios que cumplen x cantidad de pasos del algoritmo. 
#Pone en 0 también los monopolios. Se le pueden restar (cálculo de la línea 132)
table(competencia$algoritmo)

## Normalización del índice sin monopolios

bn <- bestNormalize(competencia$iglobal0, standardize = FALSE) # Normalizo el índice sin monopolios
x_boxcox <- bn$x.t

hist(x_boxcox)
shapiro.test(x_boxcox) #Hago test de normalidad sobre los datos

competencia$normal <- x_boxcox


par(mfrow = c(1, 3))
hist(competencia$iglobal) #con monopolios
hist(competencia$iglobal0) # sin monopolios
hist(competencia$normal) # sin monopolios normalizado


# A la base de competencia, se el genera la variable que verifica qué municipios superan el umbral del índice:

competencia <- competencia %>%
  mutate(pprob2=if_else(normal >= (mean(competencia$normal, na.rm = TRUE)+
                                     sd(competencia$normal, na.rm = TRUE)), 1, 0),
         pprob2=if_else(MONOPOLIO==1,2,pprob2))

summary(competencia$normal, na.rm = TRUE)
sd(competencia$normal, na.rm = TRUE)
mean(competencia$normal, na.rm = TRUE)+sd(competencia$normal, na.rm = TRUE)


#¿Cuántos municipios tendrían potenciales problemas de competencia?:
table(competencia$pprob2)
sum(competencia$pprob2 >0 , na.rm = TRUE) # total

# Comparación del resultado del índice vs resultado del algoritmo:
table(competencia$pprob2, competencia$algoritmo)

######################################################################
# ANÁLISIS HOT SPOTS

# Al mapa le pego la variable iglobal (con monopolios=1) para hacer el análisis:
municipios_mapa@data <- municipios_mapa@data %>%
  left_join(select(competencia, ID_MUNICIPIO, iglobal), by="ID_MUNICIPIO")

# Mantener los municipios originales, incluso los que tienen NA en 'iglobal'
municipios_sf <- st_as_sf(municipios_mapa) %>%
  mutate(iglobal_original = is.na(iglobal))  # Variable que indica si 'iglobal' es NA

# Eliminar sólo los municipios con NA de 'iglobal' para el análisis
municipios_sf_filtered <- municipios_sf %>%
  filter(!is.na(iglobal))  


####
## MAPA DEL ÍNDICE DE COMPETENCIA
colombia <- municipios_sf %>% filter(!ID_MUNICIPIO %in% c(88001, 88564))

mapa_iglobal <- ggplot(colombia) +
  geom_sf(aes(fill = iglobal), color = "black", lwd = 0.15) +
  scale_fill_gradient(name = "Índice",
                      low = "white",
                      high = "darkred") +
  theme_void() +
  theme(plot.title = element_text(hjust = 0.5),
        legend.position = "right")

# Filtrar las islas (ID_MUNICIPIO 88001 y 88002)
SAI_sf <- municipios_sf %>% filter(ID_MUNICIPIO %in% c(88001))
PROVIDENCIA_sf <- municipios_sf %>% filter(ID_MUNICIPIO %in% c(88564))

# Crear el mapa de las islas con zoom
mapa_SAI <- ggplot(SAI_sf) +
  geom_sf(aes(fill = iglobal), color = "black", lwd = 0.15) +
  scale_fill_gradient(name = "Índice",
                      low = "white",
                      high = "darkred") +
  theme_void() +
  theme(legend.position = "none",
        plot.margin = margin(0, 0, 0, 0),
        panel.border = element_rect(color = "gray50", fill = NA, linewidth = 1))  # Borde negro del recuadro

mapa_PROVIDENCIA <- ggplot(PROVIDENCIA_sf) +
  geom_sf(aes(fill = iglobal), color = "black", lwd = 0.15) +
  scale_fill_gradient(name = "Índice",
                      low = "white",
                      high = "darkred") +
  theme_void() +
  theme(legend.position = "none",
        plot.margin = margin(0, 0, 0, 0),
        panel.border = element_rect(color = "gray50", fill = NA, linewidth = 1))  # Borde negro del recuadro

# Imprimir el mapa con las islas en zoom
grid.newpage()
print(mapa_iglobal, vp = viewport(x = 0.5, y = 0.5, width = 1, height = 1))  # Mapa principal
print(mapa_SAI, vp = viewport(x = 0.2, y = 0.9, width = 0.05, height = 0.2))  # Zoom SAI
print(mapa_PROVIDENCIA, vp = viewport(x = 0.26, y = 0.9, width = 0.05, height = 0.2))  # Zoom en islas


###
## Continuación análisis HS

vecinos <- poly2nb(municipios_sf_filtered)  # Cálculo matriz de vecindad con los polígonos
vecinos_card <- card(vecinos) # Verificar cuantos vecinos tiene cada municipio, para más adelante sacar a los que no tienen vecinos

municipios_sf_filtered <- municipios_sf_filtered[vecinos_card > 0, ]
vecinos <- poly2nb(municipios_sf_filtered)  # Cálculo matriz de vecindad con los polígonos
pesos <- nb2listw(vecinos, style = "B", zero.policy = TRUE)  # Matriz de pesos espaciales

########################
### Global G Test (Test global de autocorrelación espacial)

globalG.test(municipios_sf_filtered$iglobal, pesos) #Si el p-valor de la prueba es <0,05, se rechaza la H0  de no clusterización
                                                    # por lo tanto, es viable hacer el ejercicio de HotSpots

municipios_sf_filtered <- municipios_sf_filtered %>%
  mutate(nb = st_contiguity(geometry),
         wt = st_weights(nb),
         tes_lag = lag.listw(pesos, iglobal)) 

# Calculate the Gi using local_g_perm
set.seed(123)
tes_hot_spots <- municipios_sf_filtered |> 
  mutate(
    Gi = local_g_perm(
      x=as.numeric(municipios_sf_filtered$iglobal), 
      nb= municipios_sf_filtered$nb, 
      wt= wt, 
      nsim = 999)
    # nsim = number of Monte Carlo simulations (999 is default)
  ) |> 
  unnest(Gi) 

# Create a new data frame called 'tes_hot_spots"
tes_hot_spots <- tes_hot_spots |> 
  # with the columns 'gi' and 'p_folded_sim"
  # 'p_folded_sim' is the p-value of a folded permutation test
  mutate(
    # Add a new column called "classification"
    classification = case_when(
      # Classify based on the following criteria:
      gi > 0 & p_folded_sim <= 0.01 ~ "Muy caliente",
      gi > 0 & p_folded_sim <= 0.05 ~ "Caliente",
      gi > 0 & p_folded_sim <= 0.1 ~ "Algo caliente",
      gi < 0 & p_folded_sim <= 0.01 ~ "Muy frío",
      gi < 0 & p_folded_sim <= 0.05 ~ "Frío",
      gi < 0 & p_folded_sim <= 0.1 ~ "Algo frío",
      TRUE ~ "No significativo"
    ),
    # Convert 'classification' into a factor for easier plotting
    classification = factor(
      classification,
      levels = c("Muy caliente", "Caliente", "Algo caliente",
                 "No significativo",
                 "Algo frío", "Frío", "Muy frío")
    )
  ) 

# Visualize the results with ggplot2

colombia <- colombia %>%
  st_join(select(tes_hot_spots, ID_MUNICIPIO, classification) , by = "ID_MUNICIPIO") 

# Definir la paleta de colores
paleta_color <- colorRampPalette(colors = c("#2165AD", "white", "#B2182B"))(9)
scales::show_col(paleta_color)

# Asegurar el orden correcto en la variable 'classification'
colombia <- colombia %>%
  mutate(classification = if_else(is.na(classification), "Sin datos", classification)) %>%
  mutate(classification = factor(classification, 
                                 levels = c("Sin datos", "Muy frío", "Frío", "Algo frío", 
                                            "No significativo", "Algo caliente", 
                                            "Caliente", "Muy caliente"),
                                 ordered = TRUE))

# Crear el mapa
hotspots_map <- ggplot(colombia, aes(fill = classification)) +
  geom_sf(color = "black", lwd = 0.03) +
  scale_fill_manual(
    values = c("Sin datos" = "#BFBFBF",  # Gris para "Sin datos"
               "Muy caliente" = paleta_color[9],  # Rojo oscuro
               "Caliente" = paleta_color[7],  # Naranja
               "Algo caliente" = paleta_color[6],  # Rojo claro
               "No significativo" = paleta_color[5], # Blanco 
               "Algo frío" = paleta_color[3],  # Rosa claro
               "Frío" = paleta_color[2],  # Azul claro
               "Muy frío" = paleta_color[1])  # Azul oscuro
  ) +
  theme_void() +
    labs(
    fill = "Clasificación Hot Spots"
  )

print(hotspots_map)

ggsave(
  filename = file.path(dir_graph, paste("Hot_Spots_", nombre_paquete, ".jpeg")),
  plot = hotspots_map, 
  width = 6, 
  height = 4, 
  dpi = 300
)

#########################
##  Comparación municipios con potenciales problemas vs hot spots
competencia <- competencia %>%
  left_join(select(tes_hot_spots, ID_MUNICIPIO, classification) , by = "ID_MUNICIPIO") 

##############
## ENTROPÍA
### Identificación de grupos para evaluar la entropía:

very_hot <- tes_hot_spots |> 
  filter(classification == "Muy caliente" | classification == "Caliente") %>%
  mutate(nb2=st_contiguity(geometry)) 

very_hot_with_neighbors <- very_hot |> 
  filter(sapply(nb2, length) > 0) 
# Crear un vector con los índices de fila consecutivos
node_ids <- seq_len(nrow(very_hot_with_neighbors))
# Verificar que los vecinos solo contengan índices dentro de 'very_hot_with_neighbors'
very_hot_with_neighbors$nb2_reindexed <- lapply(very_hot_with_neighbors$nb2, function(nb) {
  # Asegurarse de que los vecinos estén dentro del rango de los índices
  valid_nb <- nb[nb %in% node_ids]  # Filtrar vecinos que estén dentro de los índices válidos
  match(valid_nb, node_ids)  # Reindexar los vecinos válidos
})
head(very_hot_with_neighbors$nb2_reindexed)
# Crear el grafo con las vecindades válidas
graph <- graph_from_adj_list(very_hot_with_neighbors$nb2_reindexed)

components <- components(graph)
very_hot_with_neighbors <- very_hot_with_neighbors %>%
  mutate(group_id = components$membership)


###############
## DETERMINACIÓN DE VECINDADES

competencia <- competencia %>%
  left_join(select(very_hot_with_neighbors, ID_MUNICIPIO, group_id) , by = "ID_MUNICIPIO") %>%
  mutate(group_id = coalesce(group_id, 0)) 

# Número de municipios que identifica en el HS, por índice de vecindad
# Para entropía estamos evaluando los grupos de vecindades que tengan al menos 3 municipios
table(competencia$group_id)

competencia <- competencia %>%
  group_by(group_id) %>%
  mutate(cont = n(),
         group_id=if_else(group_id==0 | cont==1 | cont==2, 0, group_id),
         problemas = if_else(group_id>0 | pprob2>0 ,1, 0))

#¿Cuántas vecindades quedan? (También agrupa los 0, ese grupo no va)
unique(competencia$group_id)

#¿Cuántos municipios se deben analizar?
table(competencia$problemas, competencia$MONOPOLIO)
sum(competencia$problemas>0) # en total

table(competencia$problemas, competencia$MONOPOLIO)

# Por si se hiciera un análisis de vecindades:
table(competencia$problemas, competencia$pprob2)
table(competencia$pprob2, competencia$group_id)
xtabs(~ pprob2 + group_id, data = competencia, subset = (problemas == 1)) 

########
## IDENTIFICACIÓN Y FILTRO DE MERCADOS NO CONSOLIDADOS

# Tomo las penetraciones del servicio incluyendo los municipios que tienen monopolios
res_PEN_S0 <- indicadores (municipios0,"PEN_S")
hist(res_PEN_S0$promedio) # Distribución de las penetraciones del servicio

# Aproximo esa distribución a una normal
bn3 <- bestNormalize(res_PEN_S0$promedio, standardize = FALSE) # Normalizo la penetración con monopolios
x_boxcox3 <- bn3$x.t

shapiro.test(x_boxcox3) #Hago test de normalidad sobre los datos

res_PEN_S0$promedio_normal <- x_boxcox3


par(mfrow = c(1, 2))
hist(res_PEN_S0$promedio)
hist(res_PEN_S0$promedio_normal)


# Genero el filtro marcando como no consolidados los municipis que estén por debajo de media-sd

res_PEN_S0 <- res_PEN_S0 %>%
  mutate(consolidado= if_else(promedio_normal <= (mean(res_PEN_S0$promedio_normal, na.rm = TRUE)-
                                                    sd(res_PEN_S0$promedio_normal, na.rm = TRUE)), 0, 1))

table(res_PEN_S0$consolidado)

# Le pego esa variable a la base de competencia
competencia <- competencia %>%
  left_join(select(res_PEN_S0, ID_MUNICIPIO, consolidado), by = "ID_MUNICIPIO") %>%
  mutate(definitivo = if_else(consolidado == 0, 0, problemas))

# ¿Cuántos municipios me quedan para analizar? (cruce 1 en ambas variables)
table(competencia$problemas,competencia$consolidado)
xtabs(~ pprob2 + consolidado, data = competencia, subset = (problemas == 1)) #Identifico monopolios de no monopolios

table(competencia$problemas,competencia$definitivo)


########
# ALGUNAS TABLAS DE ANÁLISIS

municipios0 <- municipios0 %>%
  left_join(select(competencia, ID_MUNICIPIO, pprob2, group_id, problemas, consolidado, definitivo) , by = "ID_MUNICIPIO") 


table(municipios0$CLUSTER2,municipios0$definitivo)

xtabs(~ CLUSTER2 + pprob2, data = municipios0, subset = (definitivo == 1))

Mercado <- Mercado %>%
  left_join(select(competencia, ID_MUNICIPIO, pprob2, group_id, consolidado, definitivo) , by = "ID_MUNICIPIO") 

export_mpio_unicos <- competencia %>%
  select(-geometry.x, -geometry.y)

write.csv2(export_mpio_unicos, paste("Salidas/Municipios_", nombre_paquete, ".csv", sep = ""), quote = FALSE, row.names = FALSE, fileEncoding = "UTF-8")

write.csv2(Mercado, paste("Salidas/Evol_Municipios_", nombre_paquete, ".csv", sep = ""), quote = FALSE, row.names = FALSE, fileEncoding = "UTF-8")
## FIN



